unit dxForms;

interface

uses
  Classes, Forms, SysUtils, Controls;

type
  TdxFormInfo = class
  private
    FCustomFormClass: TFormClass;
    FForm: TForm;
    FFormName: string;
  protected

  public
    constructor Create(ClassType: TFormClass; const AName: string = '');

    procedure CreateForm(AOwner: TComponent);
    procedure DestroyForm;
    procedure ShowForm(AParent: TWinControl);

    property FormName: string read FFormName write FFormName;
  end;

  TdxFormManager = class
  private
    FFormList: TList;
    function GetCount: Integer;
    function GetItem(Index: Integer): TdxFormInfo;
    procedure AddNewItem(ANewItem: TdxFormInfo);
  protected
    function GetFormInfoByName(AName: string): TdxFormInfo;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Clear;

    procedure RegisterForm(ClassType: TFormClass; const AName: string = '');
    function ShowForm(AName: string; Parent: TWinControl): Boolean;
    procedure FreeForm(AName: string);

    property Count: Integer read GetCount;
    property Items[Index: Integer]: TdxFormInfo read GetItem; default;
  end;

function dxFormManager: TdxFormManager;

implementation

var
  FInstance: TdxFormManager = nil;

function dxFormManager: TdxFormManager;
begin
  if not Assigned(FInstance) then
    FInstance := TdxFormManager.Create;
  Result := FInstance;
end;

{ TdxFormInfo }

constructor TdxFormInfo.Create(ClassType: TFormClass; const AName: string);
begin
  inherited Create;
  FCustomFormClass := ClassType;
  if AName <> '' then
    FFormName := AName
  else
    FFormName := ClassType.ClassName;
end;

procedure TdxFormInfo.CreateForm(AOwner: TComponent);
begin
  FForm := FCustomFormClass.Create(AOwner);
end;

procedure TdxFormInfo.DestroyForm;
begin
  if Assigned(FForm) then
  begin
    FForm.Free;
    FForm := nil;
  end;
end;

procedure TdxFormInfo.ShowForm(AParent: TWinControl);
begin
  if not Assigned(FForm) then
    CreateForm(AParent);
  FForm.BorderStyle := bsNone;
  FForm.Parent := AParent;
  FForm.Align := alClient;
  FForm.Show;
  FForm.SetFocus;
end;

{ TdxFormManager }

procedure TdxFormManager.Clear;
var
  I: Integer;
begin
  for I := FFormList.Count - 1 downto 0 do
    TdxFormInfo(FFormList[I]).Free;
  FFormList.Clear;
end;

constructor TdxFormManager.Create;
begin
  inherited Create;
  FFormList := TList.Create;
end;

destructor TdxFormManager.Destroy;
begin
  Clear;
  FFormList.Free;
  inherited Destroy;
end;

function TdxFormManager.GetCount: Integer;
begin
  Result := FFormList.Count;
end;

function TdxFormManager.GetItem(Index: Integer): TdxFormInfo;
begin
  Result := TdxFormInfo(FFormList.Items[Index]);
end;

procedure TdxFormManager.AddNewItem(ANewItem: TdxFormInfo);
begin
  FFormList.Add(Pointer(ANewItem));
end;

function TdxFormManager.GetFormInfoByName(AName: string): TdxFormInfo;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Items[I].FormName = AName then
    begin
      Result := Items[I];
      Exit;
    end;
  Result := nil;
end;

procedure TdxFormManager.RegisterForm(ClassType: TFormClass; const AName: string);
var
  FI: TdxFormInfo;
begin
  FI := TdxFormInfo.Create(ClassType, AName);
  AddNewItem(FI);
end;

function TdxFormManager.ShowForm(AName: string; Parent: TWinControl): Boolean;
var
  FormInfo: TdxFormInfo;
begin
  FormInfo := GetFormInfoByName(AName);
  if FormInfo <> nil then
  begin
    FormInfo.ShowForm(Parent);
    Result := True;
  end
  else
    Result := False;
end;

procedure TdxFormManager.FreeForm(AName: string);
var
  FormInfo: TdxFormInfo;
begin
  FormInfo := GetFormInfoByName(AName);
  if FormInfo <> nil then
    FormInfo.DestroyForm;
end;

initialization

finalization
  if Assigned(FInstance) then
    FInstance.Free;

end.
